home *** CD-ROM | disk | FTP | other *** search
/ Sprite 1984 - 1993 / Sprite 1984 - 1993.iso / src / lib / tclX6.4c / dist / tclsrc / profrep.tcl < prev    next >
Encoding:
Text File  |  1992-11-07  |  5.0 KB  |  143 lines
  1. #
  2. # profrep  --
  3. #
  4. # Generate Tcl profiling reports.
  5. #------------------------------------------------------------------------------
  6. # Copyright 1992 Karl Lehenbauer and Mark Diekhans.
  7. #
  8. # Permission to use, copy, modify, and distribute this software and its
  9. # documentation for any purpose and without fee is hereby granted, provided
  10. # that the above copyright notice appear in all copies.  Karl Lehenbauer and
  11. # Mark Diekhans make no representations about the suitability of this
  12. # software for any purpose.  It is provided "as is" without express or
  13. # implied warranty.
  14. #------------------------------------------------------------------------------
  15. # $Id: profrep.tcl,v 2.0 1992/10/16 04:52:05 markd Rel $
  16. #------------------------------------------------------------------------------
  17. #
  18.  
  19. #@package: TclX-profrep profrep
  20.  
  21. #
  22. # Summarize the data from the profile command to the specified significant
  23. # stack depth.  Returns the maximum number of characters of any significant
  24. # stack.  (useful in columnizing reports).
  25. #
  26. proc profrep:summarize {profDataVar stackDepth sumProfDataVar} {
  27.     upvar $profDataVar profData $sumProfDataVar sumProfData
  28.  
  29.     if {(![info exists profData]) || ([catch {array size profData}] != 0)} {
  30.         error "`profDataVar' must be the name of an array returned by the `profile off' command"
  31.     }
  32.     set maxNameLen 0
  33.     foreach procStack [array names profData] {
  34.         if {[llength $procStack] < $stackDepth} {
  35.             set sigProcStack $procStack
  36.         } else {
  37.             set sigProcStack [lrange $procStack 0 [expr {$stackDepth - 1}]]
  38.         }
  39.         set maxNameLen [max $maxNameLen [clength $sigProcStack]]
  40.         if [info exists sumProfData($sigProcStack)] {
  41.             set cur $sumProfData($sigProcStack)
  42.             set add $profData($procStack)
  43.             set     new [expr [lindex $cur 0]+[lindex $add 0]]
  44.             lappend new [expr [lindex $cur 1]+[lindex $add 1]]
  45.             lappend new [expr [lindex $cur 2]+[lindex $add 2]]
  46.             set $sumProfData($sigProcStack) $new
  47.         } else {
  48.             set sumProfData($sigProcStack) $profData($procStack)
  49.         }
  50.     }
  51.     return $maxNameLen
  52. }
  53.  
  54. #
  55. # Generate a list, sorted in descending order by the specified key, contain
  56. # the indices into the summarized data.
  57. #
  58. proc profrep:sort {sumProfDataVar sortKey} {
  59.     upvar $sumProfDataVar sumProfData
  60.  
  61.     case $sortKey {
  62.         {calls} {set keyIndex 0}
  63.         {real}  {set keyIndex 1}
  64.         {cpu}   {set keyIndex 2}
  65.         default {
  66.             error "Expected a sort of: `calls',  `cpu' or ` real'"}
  67.     }
  68.  
  69.     # Build a list to sort cosisting of a fix-length string containing the
  70.     # key value and proc stack. Then sort it.
  71.  
  72.     foreach procStack [array names sumProfData] {
  73.         set key [format "%016d" [lindex $sumProfData($procStack) $keyIndex]]
  74.         lappend keyProcList [list $key $procStack]
  75.     }
  76.     set keyProcList [lsort $keyProcList]
  77.  
  78.     # Convert the assending sorted list into a descending list of proc stacks.
  79.  
  80.     for {set idx [expr [llength $keyProcList]-1]} {$idx >= 0} {incr idx -1} {
  81.         lappend sortedProcList [lindex [lindex $keyProcList $idx] 1]
  82.     }
  83.     return $sortedProcList
  84. }
  85.  
  86. #
  87. # Print the sorted report
  88. #
  89.  
  90. proc profrep:print {sumProfDataVar sortedProcList maxNameLen outFile
  91.                     userTitle} {
  92.     upvar $sumProfDataVar sumProfData
  93.     
  94.     if {$outFile == ""} {
  95.         set outFH stdout
  96.     } else {
  97.         set outFH [open $outFile w]
  98.     }
  99.  
  100.     # Output a header.
  101.  
  102.     set stackTitle "Procedure Call Stack"
  103.     set maxNameLen [max $maxNameLen [clength $stackTitle]]
  104.     set hdr [format "%-${maxNameLen}s %10s %10s %10s" $stackTitle \
  105.                     "Calls" "Real Time" "CPU Time"]
  106.     if {$userTitle != ""} {
  107.         puts $outFH [replicate - [clength $hdr]]
  108.         puts $outFH $userTitle
  109.     }
  110.     puts $outFH [replicate - [clength $hdr]]
  111.     puts $outFH $hdr
  112.     puts $outFH [replicate - [clength $hdr]]
  113.  
  114.     # Output the data in sorted order.
  115.  
  116.     foreach procStack $sortedProcList {
  117.         set data $sumProfData($procStack)
  118.         puts $outFH [format "%-${maxNameLen}s %10d %10d %10d" $procStack \
  119.                             [lindex $data 0] [lindex $data 1] [lindex $data 2]]
  120.     }
  121.     if {$outFile != ""} {
  122.         close $outFH
  123.     }
  124. }
  125.  
  126. #------------------------------------------------------------------------------
  127. # Generate a report from data collect from the profile command.
  128. #   o profDataVar (I) - The name of the array containing the data from profile.
  129. #   o sortKey (I) - Value to sort by. One of "calls", "cpu" or "real".
  130. #   o stackDepth (I) - The stack depth to consider significant.
  131. #   o outFile (I) - Name of file to write the report to.  If omitted, stdout
  132. #     is assumed.
  133. #   o userTitle (I) - Title line to add to output.
  134.  
  135. proc profrep {profDataVar sortKey stackDepth {outFile {}} {userTitle {}}} {
  136.     upvar $profDataVar profData
  137.  
  138.     set maxNameLen [profrep:summarize profData $stackDepth sumProfData]
  139.     set sortedProcList [profrep:sort sumProfData $sortKey]
  140.     profrep:print sumProfData $sortedProcList $maxNameLen $outFile $userTitle
  141.  
  142. }
  143.